home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / prolog_2.zip / EXPERT.ZIP / PSYCHIAT.PRO < prev    next >
Text File  |  1987-05-26  |  5KB  |  156 lines
  1. /*
  2.    A simulated psychiatrist program ----> Psychiat.PRO
  3.   
  4.        contributed by John Sun, 1987 using PD Prolog version 1.91P.
  5.  
  6. */          
  7.  
  8. /*
  9.    Reading in a list of words: 13 is Carriage Return, 
  10.                                8  is Backspace, 
  11.                                32 is Space.
  12.    If you spell a word wrong, try to use the backspace key to correct it.
  13. */
  14.    
  15.    get_Line([C|Cs])     :- get0(C), C \= 13, !, get_Line(Cs).
  16.    get_Line([13])       :- nl.
  17.  
  18.    edit_Line([]).
  19.    edit_Line([X|Xs])    :- X \= 8, asserta(char(X)), !, edit_Line(Xs).
  20.    edit_Line([X|Xs])    :- X = 8,  retract(char(_)), !, edit_Line(Xs).
  21.  
  22.    convert_Line([Y|Ys]) :- retract(char(X)), 
  23.                            convert_Char(X, Y), 
  24.                            !,
  25.                            convert_Line(Ys).
  26.    convert_Line([]).
  27.  
  28.    convert_Char(13, 13).
  29.    convert_Char(X,   Y) :- 65 =< X, X =< 90, Y is X + 32.
  30.    convert_Char(X,   X) :- 97 =< X, X =< 122.
  31.    convert_Char(_,  32).
  32.  
  33.    to_Memory([]).
  34.    to_Memory([X|Xs])    :- assertz(char(X)), to_Memory(Xs).
  35.  
  36.    read_word_list(Ws) :-
  37.        retract(char(C)),
  38.        read_word_list(C, Ws).
  39.  
  40.    read_word_list(C, [W|Ws]) :-
  41.        C \= 32, C \= 13,
  42.        read_word(C, W, C1),
  43.        read_word_list(C1, Ws).
  44.    read_word_list(C, Ws) :-
  45.        C = 32,
  46.        retract(char(C1)),
  47.        read_word_list(C1, Ws).
  48.    read_word_list(C, []) :-
  49.        C = 13.
  50.  
  51.    read_word(C, W, C1) :-
  52.        word_chars(C, Cs, C1),
  53.        name(W, Cs).
  54.  
  55.    word_chars(C, [C|Cs], C0) :-
  56.        C \= 13, C \= 32,
  57.        !,
  58.        retract(char(C1)),
  59.        word_chars(C1, Cs, C0).
  60.    word_chars(C, [], C) :-
  61.        (C = 32; C = 13).
  62.  
  63.    reverse(Xs, Ys)          :- reverse(Xs, [], Ys).
  64.    reverse([X|Xs], Acc, Ys) :- reverse(Xs, [X|Acc], Ys).
  65.    reverse([], Ys, Ys).
  66.  
  67.    append([], X, X).
  68.    append([X|Xs], Ys, [X|Zs]) :- append(Xs, Ys, Zs).
  69.  
  70.    get_word_list(Ws) :- get_Line(Xs), 
  71.                         edit_Line(Xs), 
  72.                         convert_Line(Ys),
  73.                         reverse(Ys, Zs),
  74.                         to_Memory(Zs),
  75.                         read_word_list(Ws).
  76.  
  77. /*
  78.    match(Pattern, Dictionary, Words) :-
  79.        Pattern matches the list of words Words, and matchings are
  80.        recorded in the Dictionary.
  81. */
  82.    match([N|Pattern], Dictionary, Target) :-
  83.        integer(N), lookup(N, Dictionary, LeftTarget),
  84.        append(LeftTarget, RightTarget, Target),
  85.        match(Pattern, Dictionary, RightTarget).
  86.    match([Word|Pattern], Dictionary, [Word|Target]) :-
  87.        atom(Word), match(Pattern, Dictionary, Target).
  88.    match([], Dictionary, []).
  89.  
  90. /*
  91.    lookup(Key, Dictionary, Value) :-
  92.        Dictionary contains Value indexed under Key.
  93.        Dictionary is represented as a list of pairs (Key, Value).
  94. */
  95.    lookup(Key, [(Key,Value)|Dictionary], Value).
  96.    lookup(Key, [(Key1, Value1)|Dictionary], Value) :-
  97.        Key \= Key1, lookup(Key, Dictionary, Value).
  98.  
  99. /*
  100.    pattern(Stimulus, Response) :-
  101.        Response is an applicable response pattern to the pattern Stimulus.
  102. */
  103.    pattern([i,am,1],['How long have you been',1,'?']).
  104.    pattern([1,you,2,me],['What makes you think I',2,'you ?']).
  105.    pattern([i,like,1,my,2],
  106.            ['Anyone else in your relationships like',1,'your',2,'?']).
  107.    pattern([i,like,1],['Does anyone else in your family like',1,'?']).
  108.    pattern([i,feel,1],['Do you often feel that way ?']).
  109.    pattern([this,is,1],['What else do you regard as',1,'?']).
  110.    pattern([1,X,2],['Can you tell me more about',X,'?']) :- important(X).
  111.    pattern([why,1,i,2],['Why',1,'you',2,'what ?']).
  112.    pattern([1,X,2,Y,3],['Why do',Y,'want to',1,X,2,3,'?']) :-
  113.        (i_you(X, Y); i_you(Y, X)).
  114.    pattern([1,X,2],['Why does',1,Y,2,'?']) :-     
  115.        (i_you(X, Y); i_you(Y, X)).
  116.    pattern([1],['I see. Please go on.']).
  117.  
  118.    i_you(i, you).       i_you(my, your).    i_you(me, you).
  119.    i_you(myself, yourself).                 i_you(mine, yours).
  120.  
  121.    important(father).   important(mother).  important(son).
  122.    important(sister).   important(brother). important(daughter).
  123.    important(friend).   important(husband). important(wife).
  124.    important(pet).      important(dog).     important(job).
  125.    important(work).     important(program). important(computer).
  126.    important(sickness). important(pain).    important(school).
  127.  
  128.    reply([Head|Tail]) :- print(Head,' '), reply(Tail).
  129.    reply([]) :- nl.
  130.  
  131. /*
  132.    help :-
  133.        Simulate a conversation via side-effects.
  134. */
  135.    help :- nl, print('Please tell me anything about yourself'),
  136.            nl, print('your family, your job, school, or this program.'),
  137.            nl, get_word_list(Input), help(Input), !.
  138.  
  139.    help([bye|_]) :-
  140.        print('Goodbye. I hope I have helped you. ').
  141.    help([see,you|_]) :-
  142.        print('Okay, see you later. If you have any questions,'), nl,
  143.        print('please do not hesitate to call me.').
  144.    help(Input) :-
  145.        pattern(Stimulus, Response),
  146.        match(Stimulus, Dictionary, Input),
  147.        match(Response, Dictionary, Output),
  148.        reply(Output),
  149.        get_word_list(Input1),
  150.        !, help(Input1).
  151.  
  152.    ?-nl, print('To start the program, type "help." '),
  153.      nl, print('To terminate the conversation, type "Bye"'),
  154.      nl.
  155.  
  156.